home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / C / Applications / SML⁄NJ 93+ / Documentation / examples / redblack2.sml < prev    next >
Encoding:
Text File  |  1995-12-30  |  1.8 KB  |  77 lines  |  [TEXT/R*ch]
  1. (* redblack2.sml *)
  2.  
  3. functor RedBlack(B : sig type key
  4.              val > : key*key->bool
  5.              end):
  6.         sig type tree
  7.         type key
  8.         val empty : tree
  9.         val insert : key * tree -> tree
  10.         val lookup : key * tree -> key
  11.         exception Notfound of key
  12.         end =
  13. struct
  14.  open B
  15.  datatype tree = empty | RED of key * tree * tree
  16.                | BLACK of key * tree * tree
  17.  exception Notfound of key
  18.  
  19.  fun insert (key,t) =
  20.   let fun f empty = RED(key,empty,empty)
  21.         | f (BLACK(k,l,r)) =
  22.         if key>k
  23.         then case f r
  24.          of r as RED(rk, rl as RED(rlk,rll,rlr),rr) =>
  25.             (case l
  26.              of RED(lk,ll,lr) =>
  27.                 RED(k,BLACK(lk,ll,lr),
  28.                        BLACK(rk,rl,rr))
  29.               | _ => BLACK(rlk,RED(k,l,rll),
  30.                         RED(rk,rlr,rr)))
  31.           | r as RED(rk,rl, rr as RED(rrk,rrl,rrr)) =>
  32.             (case l
  33.              of RED(lk,ll,lr) =>
  34.                 RED(k,BLACK(lk,ll,lr),
  35.                        BLACK(rk,rl,rr))
  36.               | _ => BLACK(rk,RED(k,l,rl),rr))
  37.               | r => BLACK(k,l,r)
  38.         else if k>key
  39.         then case f l
  40.              of l as RED(lk,ll, lr as RED(lrk,lrl,lrr)) =>
  41.             (case r
  42.              of RED(rk,rl,rr) =>
  43.                 RED(k,BLACK(lk,ll,lr),
  44.                        BLACK(rk,rl,rr))
  45.               | _ => BLACK(lrk,RED(lk,ll,lrl),
  46.                         RED(k,lrr,r)))
  47.           | l as RED(lk, ll as RED(llk,lll,llr), lr) =>
  48.             (case r
  49.              of RED(rk,rl,rr) =>
  50.                 RED(k,BLACK(lk,ll,lr),
  51.                        BLACK(rk,rl,rr))
  52.               | _ => BLACK(lk,ll,RED(k,lr,r)))
  53.               | l => BLACK(k,l,r)
  54.         else BLACK(key,l,r)
  55.         | f (RED(k,l,r)) =
  56.         if key>k then RED(k,l, f r)
  57.         else if k>key then RED(k, f l, r)
  58.         else RED(key,l,r)
  59.    in case f t
  60.       of RED(k, l as RED(_,_,_), r) => BLACK(k,l,r)
  61.        | RED(k, l, r as RED(_,_,_)) => BLACK(k,l,r)
  62.        | t => t
  63.   end
  64.  
  65.  fun lookup (key,t) =
  66.   let fun next(k,l,r) =
  67.         if k>key then look l
  68.         else if key>k then look r
  69.         else k
  70.       and look empty = raise (Notfound key)
  71.     | look (RED(a)) = next(a)
  72.     | look (BLACK(a)) = next(a)
  73.    in look t
  74.   end
  75.  
  76. end
  77.